require(parallel)
num.tags <- 320                                                         ##Number of tags to use in prediction
df_sample<-read.csv("train_sample.csv",stringsAsFactors=F)

tag.freq <- table(unlist(strsplit(df_sample$Tags," ")))                    ##Get tag names and their frequency on the training data
tag.freq <- tag.freq[rev(order(tag.freq))]
tag.names <- names(tag.freq)
tag.map<-read.csv('two_models.csv', header=T, stringsAsFactors=F)           ##tag_map.csv has regexps selected for top 300 tags
more.tags<-setdiff(tag.names[1:num.tags], tag.map$tag)
more.regexp<-gsub("-",".", more.tags,fixed=T)
more.regexp<-gsub("#","\\#", more.regexp,fixed=T)
more.regexp<-gsub("+","\\+", more.regexp,fixed=T)
tag.map<-rbind(tag.map, data.frame(tag=more.tags, regexp=more.regexp))
v.text <- tolower(df_sample$Body)
v.title <- tolower(df_sample$Title)

f <- function(i)
{
  ##Grep in body of the post
  re0  <-  paste("\\Q",tag.map$tag.name[i],"\\E",sep="")
  re1 <-  paste("^",re0," | ",re0," | ",re0,"$","|^",re0,"$",sep="")
  re2 <- tag.map$body.model[i]
  ind.pred.body <- grep(re2, v.text, perl=T, useBytes=T)
  ind.actual <- grep(re1, df_sample$Tags, perl=T, useBytes=T)

  #Grep in title of the post
  re2<-tag.map$title.model[i]
  ind.pred.title <- grep(re2, v.title, perl=T, useBytes=T)

  #specificity if both title and body match regexp
  ind.pred.both<-intersect(ind.pred.body, ind.pred.title)
  if (length(ind.pred.both)>0) spec1<-length(intersect(ind.pred.both, ind.actual))/length(ind.pred.both)  else spec1 <- 0

  #specificity if body but not title
  ind.pred.body.only <- setdiff(ind.pred.body, ind.pred.title)
  if (length(ind.pred.body.only)>0) spec2<-length(intersect(ind.pred.body.only, ind.actual))/length(ind.pred.body.only)  else spec2 <- 0

  #specificity if title only but not body
  ind.pred.title.only <- setdiff(ind.pred.title, ind.pred.body)
  if (length(ind.pred.title.only)>0) spec3<-length(intersect(ind.pred.title.only, ind.actual))/length(ind.pred.title.only)  else spec3 <- 0


  cat(i, tag.names[i], spec1, spec2, spec3, "\n")

  list(res.tagnum=i,tag.name=tag.names[i], ind.pred.both=ind.pred.both, ind.pred.body.only=ind.pred.body.only,
       ind.pred.title.only=ind.pred.title.only,  spec1=spec1, spec2=spec2, spec3=spec3)
}

b <-  mclapply(1:320 , f, mc.cores=32)




spec1 <- sapply(1:length(b), function(i) b[[i]]$spec1)
spec2 <- sapply(1:length(b), function(i) b[[i]]$spec2)
spec3 <- sapply(1:length(b), function(i) b[[i]]$spec3)


spec<-rep("", nrow(df_sample))
predictions <- rep("", nrow(df_sample))

for(i in 1:length(b))
{
  ind <- b[[i]]$ind.pred.both
  predictions[ind] <- paste(predictions[ind],tag.map$tag[i])
  spec[ind]<-paste(spec[ind],spec1[i])

  ind <- b[[i]]$ind.pred.body.only
  predictions[ind] <- paste(predictions[ind],tag.map$tag[i])
  spec[ind]<-paste(spec[ind],spec2[i])

  ind <- b[[i]]$ind.pred.title.only
  predictions[ind] <- paste(predictions[ind],tag.map$tag[i])
  spec[ind]<-paste(spec[ind],spec3[i])

}

perf.info <- data.frame(tag=tag.map$tag,tag.map$regexp,spec1=spec1,spec2=spec2,spec3=spec3)
write.csv(perf.info, "perf_info.csv")
predictions <- substring(predictions, 2)
spec<-substring(spec, 2)

num.to.keep <- function(p)
{
  a <- vector("list",length(p))
  a <- lapply(1:length(a), function(i) a[[i]] <- c(0,1))
  outcomes <- expand.grid(a)
  prob.outcome <- sapply(1:nrow(outcomes),function(i)prod(p[unlist(outcomes[i,]>0)])*prod(1-p[unlist(outcomes[i,]==0)]))
  Ef <- rep(NA, length(p))
  for(j in 1:length(p))
  {
    a.try <- rep(0, length(p))
    a.try[1:j] <- 1
    tp <- as.matrix(outcomes)%*%a.try
    prec <- tp/j
    rec <- tp/apply(outcomes, 1, sum)
    f <- 2*prec*rec/(prec+rec)
    f[is.na(f)] <- 0
    Ef[j] <- sum(f*prob.outcome)
  }
  if(max(Ef)<.05) 0
  else which.max(Ef)
}

##Now predictions must be ordered by specificity and only the most powerful ones retained

g <- function(i)
{
  print(i)
  if(predictions[i]=="") return("")
  v_pred <- unlist(strsplit(predictions[i]," "))
  v_spec <- as.numeric(unlist(strsplit(spec[i]," ")))
  v_pred <- v_pred[rev(order(v_spec))]
  v_spec <- v_spec[rev(order(v_spec))]
  if (length(v_pred)>5)
  {
    v_pred <- v_pred[1:5]
    v_spec <- v_spec[1:5]
  }
  print(v_spec)
  n <- num.to.keep(v_spec)
  cat(length(v_pred), " predictions, keeping ", n, "\n")
  if (n==0) ""  else   paste(v_pred[1:n],collapse=" ")
}


ans <- mclapply(1:length(predictions), g, mc.cores=16)

predictions<-unlist(ans)
predictions[predictions==""] <- "c# java javascript c++"

F1 <- function(pred,actual)
{
	tp <- sum(sapply(1:length(pred), function(n) max(actual == pred[n])))
	if(tp == 0) return(0)
	prec <- tp/length(pred)
	recall <- tp/length(actual)
	2*prec*recall/(prec + recall)
}

mean(sapply(1:length(predictions), function (n) F1(unlist(strsplit(predictions[n],split=" ")),
                                                  unlist(strsplit(df_sample$Tags[n], split=" ")))))

f<-sapply(1:length(predictions), function (n) F1(unlist(strsplit(predictions[n],split=" ")),
                                                  unlist(strsplit(df_sample$Tags[n], split=" "))))
